home *** CD-ROM | disk | FTP | other *** search
/ Business Shareware / Business Shareware.iso / start / wordproc / me_cd25 / muttmode.mut < prev    next >
Encoding:
Text File  |  1992-11-09  |  4.8 KB  |  189 lines
  1.   ;; muttmode.mut : an electric Mutt mode
  2.   ;; C Durland    Public Domain
  3.  
  4. (const
  5.   Mutt-wrapper 75    ; column to wrap block comments at
  6.  
  7.   Mutt-start-comment ";; "    ; what a comment usually starts with
  8.  
  9.   Enter-key-action "newline-and-indent"
  10. )
  11.  
  12. (defun
  13.   mutt-mode
  14.   {
  15.     (clear-modes)
  16.  
  17.     (bind-local-key Enter-key-action      "^M")
  18.     (bind-local-key "Mutt-mode-{"      "{")
  19.     (bind-local-key "Dr.Commento"      "M-;")
  20.     (bind-local-key "BS-untabify"      "^H")
  21.     (bind-local-key "format-Mutt-comment" "M-J")
  22.     (bind-local-key "deref-key"          "F-3")
  23.     (bind-local-key "pgm-completer"      "F-4")
  24.  
  25.     (major-mode "Mutt")
  26.   }
  27. )
  28.  
  29. (include me2.h)
  30. (include bs_untab.mut)
  31. (include block.mut)
  32.  
  33. (defun
  34.   deref-key    ;; insert name of the function bound to a key
  35.   {
  36.     (string key bind)
  37.     (key (ask "Key: "))
  38.     (if (!= "" (bind (key-bound-to key)))(insert-text bind))
  39.   }
  40.   pgm-completer        ; use command completion
  41.     { (insert-text (complete 0x17 "command: ")) }
  42.   "Mutt-mode-{"        ; handle {
  43.   {
  44.     (int key n)
  45.  
  46.     (insert-text "{")(update)
  47.     (switch (key (get-key))
  48.       Space-bar
  49.         (if (looking-at '\ *$')    ; only ws til end of line
  50.       { (insert-text " () }")(arg-prefix 3)(previous-character) }
  51.       (insert-text " ")
  52.     )
  53.       Enter-key
  54.         {
  55.       (newline-and-indent)(n (+ 2 (current-column)))
  56.       (if (looking-at '\ *$')    ; white space to end of line
  57.         {
  58.           (insert-text "}")
  59.           (beginning-of-line)(open-line)(to-col n)
  60.           (insert-text "()")(previous-character)
  61.         }
  62.         (to-col n)
  63.       )
  64.     }
  65.       default (exe-key key)
  66.     )
  67.   }
  68. )
  69.  
  70. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  71. ;;;;;;;;;;;;;;;;;;; Comment Mode ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  72. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  73.  
  74. (defun
  75.   Dr.Commento        ;; Start up a block comment
  76.   {
  77.     (int col)
  78.  
  79.     (col (current-column))(beginning-of-line)
  80.     (if (looking-at '\ *$')    ;; blank line => can start a block comment
  81.       { (current-column col)(insert-text Mutt-start-comment) }
  82.       {
  83.     (if (looking-at '\ *;')    ; "blanks ;" => can restart a block comment
  84.       (current-column col)
  85.       {
  86.         ;; none of the above => bad place for a comment
  87.         (current-column col)
  88.         (msg "Not a valid place to start a block comment!")
  89.         (done)
  90.       })
  91.       })
  92.     ;; finish up turning on block comment mode
  93.     (word-wrap Mutt-wrapper)
  94.  
  95.     (bind-local-key "Dr.Enter"        "C-M")
  96.     (bind-local-key "end-Mutt-comment"    "M-;")
  97.     (minor-mode "Dr. Commento")
  98.   }
  99.   end-Mutt-comment
  100.   {
  101.     (int col)
  102.  
  103.     ;; if [ws];[;...][ws] only thing on line, clear the line
  104.     (col (current-column))
  105.     (beginning-of-line)
  106.     (if (looking-at '\ *;+\ *$')    ; [ws];[;...][ws]$
  107.       (cut-line)
  108.       (current-column col))
  109.  
  110.     ;; turn off comment mode
  111.     (minor-mode "")
  112.     (word-wrap 0)
  113.     (bind-local-key Enter-key-action    "C-M")
  114.     (bind-local-key "Dr.Commento"    "M-;")
  115.   }
  116.   Dr.Enter        ; handle Return
  117.   {
  118.     (int key)
  119.  
  120.     (open-line)(beginning-of-line)
  121.     (if (looking-at '\(\ *;+\ *\)') ; [ws];[;...][ws]
  122.     {
  123.       (forward-line 1)
  124.       (insert-text (get-matched '\1'))
  125.     })
  126.   }
  127. )
  128.  
  129. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  130. ;;;;;;;; Format block comment ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  131. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  132.  
  133. (defun
  134.   format-Mutt-comment
  135.   {
  136.     (int offset code-buffer-id scrbuf bag-id)
  137.     (string semis)
  138.  
  139.     (code-buffer-id (current-buffer))
  140.     (delete-region-as-block)
  141.  
  142.     (current-buffer (scrbuf (create-buffer scratch-buffer)))
  143.     (clear-buffer)
  144.     (insert-bag CUT-BUFFER)
  145.  
  146.     ; get the ;'s that start a comment
  147.     (beginning-of-buffer)
  148.     (semis
  149.       (if (re-search-forward '^\ *\(;+\)')        ; [ws];[;...]
  150.         (get-matched '\1')
  151.         ";;"    ; if no ;'s, use my favorite
  152.       ))
  153.     ; Get the block offset from left margin
  154.     ; Hopefully on same line as start comment
  155.     (beginning-of-line)
  156.     (while (is-space) (next-character))
  157.     (offset (current-column))
  158.  
  159.     (beginning-of-buffer)
  160.     (re-search-replace '^\ *;+' "")    ; get rid of [white-space];[;...]
  161.     (msg "Formatting comment ...")
  162.     (beginning-of-buffer)
  163.     (adjust-lines 10000 (- Mutt-wrapper (- offset 1) (length-of semis)) FALSE)
  164.     (beginning-of-buffer)
  165.     
  166.     ; put ;'s in front of text
  167.     (while (not (EoB))
  168.     {
  169.       (if (looking-at '^$')
  170.         { (arg-prefix 1)(cut-line)(continue) }        ; remove blank lines
  171.     { (to-col offset)(insert-text semis) }        ; else prepend ;
  172.       )
  173.       (forward-line 1)
  174.     })
  175.  
  176.     ; replace comment
  177.     (beginning-of-buffer)(set-mark)(end-of-buffer)
  178.     (append-to-bag (bag-id (create-bag)) APPEND-REGION)
  179.  
  180.     (msg "Comment formatted.")
  181.  
  182.     (current-buffer code-buffer-id)
  183.     (insert-bag bag-id)
  184.  
  185.     ; clean up
  186.     (free-buffer scrbuf)(free-bag bag-id)
  187.   }
  188. )
  189.